home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / f2c / may_5_92.lha / f2c.VMay_5_1992 / libI77 / fmt.c < prev    next >
C/C++ Source or Header  |  1992-05-07  |  7KB  |  435 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "fmt.h"
  4. #define skip(s) while(*s==' ') s++
  5. #ifdef interdata
  6. #define SYLMX 300
  7. #endif
  8. #ifdef pdp11
  9. #define SYLMX 300
  10. #endif
  11. #ifdef vax
  12. #define SYLMX 300
  13. #endif
  14. #ifndef SYLMX
  15. #define SYLMX 300
  16. #endif
  17. #define GLITCH '\2'
  18.     /* special quote character for stu */
  19. extern int cursor,scale;
  20. extern flag cblank,cplus;    /*blanks in I and compulsory plus*/
  21. struct syl syl[SYLMX];
  22. int parenlvl,pc,revloc;
  23.  
  24. char *f_s(),*f_list(),*i_tem(),*gt_num();
  25.  
  26. pars_f(s) char *s;
  27. {
  28.     parenlvl=revloc=pc=0;
  29.     if(f_s(s,0) == NULL)
  30.     {
  31.         return(-1);
  32.     }
  33.     return(0);
  34. }
  35. char *f_s(s,curloc) char *s;
  36. {
  37.     skip(s);
  38.     if(*s++!='(')
  39.     {
  40.         return(NULL);
  41.     }
  42.     if(parenlvl++ ==1) revloc=curloc;
  43.     if(op_gen(RET,curloc,0,0)<0 ||
  44.         (s=f_list(s))==NULL)
  45.     {
  46.         return(NULL);
  47.     }
  48.     skip(s);
  49.     return(s);
  50. }
  51. char *f_list(s) char *s;
  52. {
  53.     for(;*s!=0;)
  54.     {    skip(s);
  55.         if((s=i_tem(s))==NULL) return(NULL);
  56.         skip(s);
  57.         if(*s==',') s++;
  58.         else if(*s==')')
  59.         {    if(--parenlvl==0)
  60.             {
  61.                 (void) op_gen(REVERT,revloc,0,0);
  62.                 return(++s);
  63.             }
  64.             (void) op_gen(GOTO,0,0,0);
  65.             return(++s);
  66.         }
  67.     }
  68.     return(NULL);
  69. }
  70. char *i_tem(s) char *s;
  71. {    char *t;
  72.     int n,curloc;
  73.     if(*s==')') return(s);
  74.     if(ne_d(s,&t)) return(t);
  75.     if(e_d(s,&t)) return(t);
  76.     s=gt_num(s,&n);
  77.     if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);
  78.     return(f_s(s,curloc));
  79. }
  80. ne_d(s,p) char *s,**p;
  81. {    int n,x,sign=0;
  82.     char *ap_end();
  83.     struct syl *sp;
  84.     switch(*s)
  85.     {
  86.     default:
  87.         return(0);
  88.     case ':': (void) op_gen(COLON,0,0,0); break;
  89.     case '$':
  90.         (void) op_gen(NONL, 0, 0, 0); break;
  91.     case 'B':
  92.     case 'b':
  93.         if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0);
  94.         else (void) op_gen(BN,0,0,0);
  95.         break;
  96.     case 'S':
  97.     case 's':
  98.         if(*(s+1)=='s' || *(s+1) == 'S')
  99.         {    x=SS;
  100.             s++;
  101.         }
  102.         else if(*(s+1)=='p' || *(s+1) == 'P')
  103.         {    x=SP;
  104.             s++;
  105.         }
  106.         else x=S;
  107.         (void) op_gen(x,0,0,0);
  108.         break;
  109.     case '/': (void) op_gen(SLASH,0,0,0); break;
  110.     case '-': sign=1;
  111.     case '+':    s++;    /*OUTRAGEOUS CODING TRICK*/
  112.     case '0': case '1': case '2': case '3': case '4':
  113.     case '5': case '6': case '7': case '8': case '9':
  114.         s=gt_num(s,&n);
  115.         switch(*s)
  116.         {
  117.         default:
  118.             return(0);
  119.         case 'P':
  120.         case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break;
  121.         case 'X':
  122.         case 'x': (void) op_gen(X,n,0,0); break;
  123.         case 'H':
  124.         case 'h':
  125.             sp = &syl[op_gen(H,n,0,0)];
  126.             *(char **)&sp->p2 = s + 1;
  127.             s+=n;
  128.             break;
  129.         }
  130.         break;
  131.     case GLITCH:
  132.     case '"':
  133.     case '\'':
  134.         sp = &syl[op_gen(APOS,0,0,0)];
  135.         *(char **)&sp->p2 = s;
  136.         if((*p = ap_end(s)) == NULL)
  137.             return(0);
  138.         return(1);
  139.     case 'T':
  140.     case 't':
  141.         if(*(s+1)=='l' || *(s+1) == 'L')
  142.         {    x=TL;
  143.             s++;
  144.         }
  145.         else if(*(s+1)=='r'|| *(s+1) == 'R')
  146.         {    x=TR;
  147.             s++;
  148.         }
  149.         else x=T;
  150.         s=gt_num(s+1,&n);
  151.         s--;
  152.         (void) op_gen(x,n,0,0);
  153.         break;
  154.     case 'X':
  155.     case 'x': (void) op_gen(X,1,0,0); break;
  156.     case 'P':
  157.     case 'p': (void) op_gen(P,1,0,0); break;
  158.     }
  159.     s++;
  160.     *p=s;
  161.     return(1);
  162. }
  163. e_d(s,p) char *s,**p;
  164. {    int n,w,d,e,found=0,x=0;
  165.     char *sv=s;
  166.     s=gt_num(s,&n);
  167.     (void) op_gen(STACK,n,0,0);
  168.     switch(*s++)
  169.     {
  170.     default: break;
  171.     case 'E':
  172.     case 'e':    x=1;
  173.     case 'G':
  174.     case 'g':
  175.         found=1;
  176.         s=gt_num(s,&w);
  177.         if(w==0) break;
  178.         if(*s=='.')
  179.         {    s++;
  180.             s=gt_num(s,&d);
  181.         }
  182.         else d=0;
  183.         if(*s!='E' && *s != 'e')
  184.             (void) op_gen(x==1?E:G,w,d,0);    /* default is Ew.dE2 */
  185.         else
  186.         {    s++;
  187.             s=gt_num(s,&e);
  188.             (void) op_gen(x==1?EE:GE,w,d,e);
  189.         }
  190.         break;
  191.     case 'O':
  192.     case 'o':
  193.         found = 1;
  194.         s = gt_num(s, &w);
  195.         if(w==0) break;
  196.         (void) op_gen(O, w, 0, 0);
  197.         break;
  198.     case 'L':
  199.     case 'l':
  200.         found=1;
  201.         s=gt_num(s,&w);
  202.         if(w==0) break;
  203.         (void) op_gen(L,w,0,0);
  204.         break;
  205.     case 'A':
  206.     case 'a':
  207.         found=1;
  208.         skip(s);
  209.         if(*s>='0' && *s<='9')
  210.         {    s=gt_num(s,&w);
  211.             if(w==0) break;
  212.             (void) op_gen(AW,w,0,0);
  213.             break;
  214.         }
  215.         (void) op_gen(A,0,0,0);
  216.         break;
  217.     case 'F':
  218.     case 'f':
  219.         found=1;
  220.         s=gt_num(s,&w);
  221.         if(w==0) break;
  222.         if(*s=='.')
  223.         {    s++;
  224.             s=gt_num(s,&d);
  225.         }
  226.         else d=0;
  227.         (void) op_gen(F,w,d,0);
  228.         break;
  229.     case 'D':
  230.     case 'd':
  231.         found=1;
  232.         s=gt_num(s,&w);
  233.         if(w==0) break;
  234.         if(*s=='.')
  235.         {    s++;
  236.             s=gt_num(s,&d);
  237.         }
  238.         else d=0;
  239.         (void) op_gen(D,w,d,0);
  240.         break;
  241.     case 'I':
  242.     case 'i':
  243.         found=1;
  244.         s=gt_num(s,&w);
  245.         if(w==0) break;
  246.         if(*s!='.')
  247.         {    (void) op_gen(I,w,0,0);
  248.             break;
  249.         }
  250.         s++;
  251.         s=gt_num(s,&d);
  252.         (void) op_gen(IM,w,d,0);
  253.         break;
  254.     }
  255.     if(found==0)
  256.     {    pc--; /*unSTACK*/
  257.         *p=sv;
  258.         return(0);
  259.     }
  260.     *p=s;
  261.     return(1);
  262. }
  263. op_gen(a,b,c,d)
  264. {    struct syl *p= &syl[pc];
  265.     if(pc>=SYLMX)
  266.     {    fprintf(stderr,"format too complicated:\n");
  267.         sig_die(fmtbuf, 1);
  268.     }
  269.     p->op=a;
  270.     p->p1=b;
  271.     p->p2=c;
  272.     p->p3=d;
  273.     return(pc++);
  274. }
  275. char *gt_num(s,n) char *s; int *n;
  276. {    int m=0,cnt=0;
  277.     char c;
  278.     for(c= *s;;c = *s)
  279.     {    if(c==' ')
  280.         {    s++;
  281.             continue;
  282.         }
  283.         if(c>'9' || c<'0') break;
  284.         m=10*m+c-'0';
  285.         cnt++;
  286.         s++;
  287.     }
  288.     if(cnt==0) *n=1;
  289.     else *n=m;
  290.     return(s);
  291. }
  292. #define STKSZ 10
  293. int cnt[STKSZ],ret[STKSZ],cp,rp;
  294. flag workdone, nonl;
  295.  
  296. integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
  297. {    struct syl *p;
  298.     int n,i;
  299.     for(i=0;i<*number;i++,ptr+=len)
  300.     {
  301. loop:    switch(type_f((p= &syl[pc])->op))
  302.     {
  303.     default:
  304.         fprintf(stderr,"unknown code in do_fio: %d\n%s\n",
  305.             p->op,fmtbuf);
  306.         err(elist->cierr,100,"do_fio");
  307.     case NED:
  308.         if((*doned)(p))
  309.         {    pc++;
  310.             goto loop;
  311.         }
  312.         pc++;
  313.         continue;
  314.     case ED:
  315.         if(cnt[cp]<=0)
  316.         {    cp--;
  317.             pc++;
  318.             goto loop;
  319.         }
  320.         if(ptr==NULL)
  321.             return((*doend)());
  322.         cnt[cp]--;
  323.         workdone=1;
  324.         if((n=(*doed)(p,ptr,len))>0) err(elist->cierr,errno,"fmt");
  325.         if(n<0) err(elist->ciend,(EOF),"fmt");
  326.         continue;
  327.     case STACK:
  328.         cnt[++cp]=p->p1;
  329.         pc++;
  330.         goto loop;
  331.     case RET:
  332.         ret[++rp]=p->p1;
  333.         pc++;
  334.         goto loop;
  335.     case GOTO:
  336.         if(--cnt[cp]<=0)
  337.         {    cp--;
  338.             rp--;
  339.             pc++;
  340.             goto loop;
  341.         }
  342.         pc=1+ret[rp--];
  343.         goto loop;
  344.     case REVERT:
  345.         rp=cp=0;
  346.         pc = p->p1;
  347.         if(ptr==NULL)
  348.             return((*doend)());
  349.         if(!workdone) return(0);
  350.         if((n=(*dorevert)()) != 0) return(n);
  351.         goto loop;
  352.     case COLON:
  353.         if(ptr==NULL)
  354.             return((*doend)());
  355.         pc++;
  356.         goto loop;
  357.     case NONL:
  358.         nonl = 1;
  359.         pc++;
  360.         goto loop;
  361.     case S:
  362.     case SS:
  363.         cplus=0;
  364.         pc++;
  365.         goto loop;
  366.     case SP:
  367.         cplus = 1;
  368.         pc++;
  369.         goto loop;
  370.     case P:    scale=p->p1;
  371.         pc++;
  372.         goto loop;
  373.     case BN:
  374.         cblank=0;
  375.         pc++;
  376.         goto loop;
  377.     case BZ:
  378.         cblank=1;
  379.         pc++;
  380.         goto loop;
  381.     }
  382.     }
  383.     return(0);
  384. }
  385. en_fio()
  386. {    ftnint one=1;
  387.     return(do_fio(&one,(char *)NULL,(ftnint)0));
  388. }
  389. fmt_bg()
  390. {
  391.     workdone=cp=rp=pc=cursor=0;
  392.     cnt[0]=ret[0]=0;
  393. }
  394. type_f(n)
  395. {
  396.     switch(n)
  397.     {
  398.     default:
  399.         return(n);
  400.     case RET:
  401.         return(RET);
  402.     case REVERT: return(REVERT);
  403.     case GOTO: return(GOTO);
  404.     case STACK: return(STACK);
  405.     case X:
  406.     case SLASH:
  407.     case APOS: case H:
  408.     case T: case TL: case TR:
  409.         return(NED);
  410.     case F:
  411.     case I:
  412.     case IM:
  413.     case A: case AW:
  414.     case O:
  415.     case L:
  416.     case E: case EE: case D:
  417.     case G: case GE:
  418.         return(ED);
  419.     }
  420. }
  421. char *ap_end(s) char *s;
  422. {    char quote;
  423.     quote= *s++;
  424.     for(;*s;s++)
  425.     {    if(*s!=quote) continue;
  426.         if(*++s!=quote) return(s);
  427.     }
  428.     if(elist->cierr) {
  429.         errno = 100;
  430.         return(NULL);
  431.     }
  432.     fatal(100, "bad string");
  433.     /*NOTREACHED*/ return 0;
  434. }
  435.